home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 January / macformat-020.iso / Shareware City / Applications / Alpha.5.96 folder / Tcl / UserCode / MacPerl.tcl < prev    next >
Encoding:
Text File  |  1994-09-21  |  39.3 KB  |  1,279 lines  |  [TEXT/ALFA]
  1. #############################################################################
  2. # MacPerl.tcl
  3. # -----------
  4. #
  5. # This is a set of routines that allow Alpha to act as a front end for the
  6. # standalone MacPerl application and that allow Perl scripts to be used as 
  7. # text filters in Alpha.  These functions are accessed through a special
  8. # MacPerl menu.
  9. #
  10. # To install the menu, choose "MacPerl" from the "Utils/Install" menu.
  11. #
  12. # The features of this package are explained in the file "MacPerl Help",
  13. # accessible from the Help menu.
  14. #
  15. #############################################################################
  16. #
  17. # If you don't already have MacPerl, it's available by anonymous ftp from
  18. # the umich site
  19. #
  20. #   mac.archive.umich.edu    [141.211.165.34]    mac/development/languages                            (4)
  21. #
  22. # and its mirrors.  Also, MacPerl's home site is 
  23. #
  24. #   ftp.switch.ch            [130.59.1.40]        software/mac/src/mpw_c
  25. #
  26. # MacPerl was written (ported to the Mac) by 
  27. #        Matthias Neeracher <neeri@iis.ee.ethz.ch> , and
  28. #        Tim Endres <time@ice.com>.
  29. #
  30. #############################################################################
  31. # Authors: W. Thomas Pollard (pollard@chem.columbia.edu)
  32. #          Martijn Koster (m.koster@nexor.co.uk)
  33. #
  34. # Version History:
  35. #
  36. # 1.5  9/94  -  MacPerl menu rearranged somewhat.
  37. #               Explicit "Get Output Window" command added to menu.
  38. #               Reading "#!" line for args is incompatible w/ standard,
  39. #                   so it's been dropped.
  40. #               Only scan the first 40 output lines for error messages (faster)
  41. #                "wrapFilterScript" no longer opens STDIN
  42. #               Text filters may now use command-line args
  43. #               STDIN for text filters passed as explicit cmd-line arg 
  44. # 1.4  9/94  -  The "#!" line of every script is read for command-line args,
  45. #                    which are passed explicitly to MacPerl with the script.
  46. #                "PromptForArgs" menu flag added.
  47. #                "perlCmdlineArgs" modeVar holds default command-line args.
  48. #                Scripts are sent using custom "perlDoScript2" proc, which
  49. #                    allows passing of explicit command-line args.
  50. # 1.3  9/94  -  When any script generates a compilation error, the file 
  51. #                    containing the script is brought up with the offending 
  52. #                    line highlighted; all error output is also written to
  53. #                    a "Perl Error Messages" window.
  54. #                'repeatLastFilter' runs again the last text-filter script used.
  55. #                'perlLastFilter' modeVar holds pathname of last filter.
  56. #                Menu flags now mirrored as modeVars, so they can be saved and
  57. #                    restored between sessions.
  58. #                Minor bug fixes.
  59. # 1.2  8/94  -  'retrieveOutput' and 'autoSwitch' flags added.
  60. #                'openInMacperl' added.
  61. #                MacPerl output window now closed before new scripts are sent.
  62. #                Filters now abort if there are compilation errors, and
  63. #                MacPerl diagnostic output retrieved and displayed in Alpha.
  64. # 1.1  8/94  -  'quitMacperl' added.
  65. #               perl-mode file-marking updated for Alpha 5.90
  66. #               Simplified installation via 'loadMacperl'(Pete Keleher). 
  67. # 1.0  7/94  -  perl-mode setup updated for Alpha 5.85:
  68. #                    keyword colorization supported
  69. #                    custom file-marking added
  70. #               #! lines in filter scripts now handled correctly 
  71. #               Workarounds installed for AppleEvent bug in MacPerl 4.1.3
  72. # 0.9  3/94  -  perl-mode stuff added, and
  73. #               highlighted 'Perl commands' file (man page) prepared
  74. #               minor bug fixes, too
  75. # 0.8  3/94  -  flags are now check-marked
  76. # 0.7  3/94  -  nested Text Filters folder now supported
  77. #               menu format modified somewhat
  78. # 0.6  3/94  -  'applyToBuffer' flag added
  79. #               scripts in Alpha buffers can now be used as filters 
  80. # 0.5  2/94  -  'filters', 'open special' submenu added
  81. #               'overwrite' flag added
  82. # 0.2  1/94  -  menu support added (MK)
  83. #               'execute selection', 'execute buffer' commands added
  84. # 0.1  9/93  -  text filter functionality created (WTP)
  85. #                  
  86. #   Comments, suggestions, bug reports, etc., should be directed to 
  87. #   Tom Pollard (pollard@chem.columbia.edu).
  88. #
  89. #############################################################################
  90. #  Default settings for the Perl menu flags  
  91. #
  92. set perlGetOutput 1
  93. set perlAutoSwitch 1
  94. set perlOverwrite 0
  95. set perlUsebuffer 1
  96. set perlPromptArgs 0
  97.  
  98. set perlPrevScript {*startup*}
  99. set perlCmdlineArgs {}
  100.  
  101. # Make duplicate copies of these variables as modeVars, taking responsibility
  102. # for keeping the two sets consistent (argh!)
  103.  
  104. newModeVar Perl perlGetOutput $perlGetOutput 1
  105. newModeVar Perl perlAutoSwitch $perlAutoSwitch 1
  106. newModeVar Perl perlOverwrite $perlOverwrite 1
  107. newModeVar Perl perlUsebuffer $perlUsebuffer 1
  108. newModeVar Perl perlPromptArgs $perlPromptArgs 1
  109.  
  110. newModeVar Perl perlLastFilter $perlPrevScript 0
  111. newModeVar Perl perlCmdlineArgs $perlCmdlineArgs 0
  112.  
  113. #############################################################################
  114. #  To install the MacPerl package, the user is prompted to locate his
  115. #  MacPerl application.  This information (necessary for building the MacPerl
  116. #  menu) recorded in UserStartup.tcl, along with commands that will load
  117. #  MacPerl mode automatically in the future.
  118. #
  119. proc loadMacPerl {} {
  120.     global macperlPath mode modeMenus HOME
  121.     set name [lindex [winNames -f] 0]
  122.         
  123.     if {[askyesno "Install the MacPerl menu?"] == "yes"} {
  124.         set f [getfile {Where is your MacPerl application?"}]
  125.         
  126.         # modify UserStartup.tcl so that Perl menu loads automatically
  127.         addUserLine "\r\# The next three lines enable the MacPerl menu."
  128.         addUserLine "set macperlPath \"$f\""
  129.         addUserLine "source \"\$HOME:Tcl:UserCode:MacPerl.tcl\""
  130.         addUserLine "enableMenuItem -m install MacPerl 0"
  131.         
  132.         # enable Perl menu for this session
  133.         set macperlPath $f
  134.         
  135.         if {[askyesno "Display MacPerl menu in Text mode?"] == "yes"} {
  136.             addUserLine "lappend modeMenus(Text) {perlMenu}"
  137.             lappend modeMenus(Text) {perlMenu}
  138.         }
  139.         
  140.         if {[askyesno "Copy sample Text Filters to your MacPerl folder?"] == "yes"} {
  141.             if {[catch {cpdir "$HOME:Tcl:UserCode:Text Filters" [macperlFolder]}]} {
  142.                 alertnote "Text Filters folder couldn't be copied"
  143.             } else {
  144.                 alertnote "Text Filters folder was successfully copied" 
  145.             }
  146.         }
  147.         
  148.         rebuildPerlMenu
  149.         enableMenuItem -m install "MacPerl" 0
  150.  
  151.         # reset the mode, so that Perl menu is inserted if required
  152.         set currentMode $mode
  153.         changeMode none
  154.         changeMode $currentMode
  155.     }
  156. }
  157.  
  158. #############################################################################
  159. #  Return paths to standard files, based on the path to MacPerl:
  160. #
  161. proc macperlFolder {} {
  162.    global macperlPath
  163.    regexp {(.*):([^:]*)} $macperlPath pathname dirname filename
  164.    return ${dirname}:
  165. }
  166.  
  167. proc stdinPath {} {
  168.    return [macperlFolder]STDIN
  169. }
  170.  
  171. proc stdoutPath {} {
  172.    return [macperlFolder]STDOUT
  173. }
  174.  
  175. proc scriptPath {} {
  176.    return [macperlFolder]SCRIPT
  177. }
  178.  
  179. proc scriptFolder {} {
  180.    return "[macperlFolder]Text Filters:"
  181. }
  182.  
  183. #############################################################################
  184. #  This is a generally useful proc that builds a hierarchical menu 
  185. #  from the files in a given folder and all subfolders.  As the menu is
  186. #  built, the pathnames of the various files are saved in the array
  187. #  indicated  by $filePaths.  The index of the file's path in this array
  188. #  is formed by concatenating the submenu name and filename, allowing the
  189. #  pathname to be retrieved by the procedure $proc when the menu item is
  190. #  selected.
  191. #
  192. proc buildSubMenu {folder name proc filePaths} {
  193.     global $filePaths
  194.     if {$name == 0} {
  195.         set name [file tail [file dirname $folder]]
  196.     }
  197.     if {$proc == 0} {
  198.         set pproc ""
  199.     } else {
  200.         set pproc "-p $proc"
  201.     }
  202.     set menu {}
  203.     set filenames [glob -nocomplain  $folder\*]
  204.     if {[llength $filenames] > 0} {
  205.        foreach m $filenames {
  206.           if {[file isdirectory $m]} {
  207.               lappend menu [buildSubMenu ${m}: 0 $proc $filePaths] 
  208.           } elseif {[file isfile $m]} {
  209.               set fname [file tail $m]
  210.               lappend menu $fname
  211.               set ${filePaths}($name:$fname) $m
  212.           }
  213.          }
  214.     }
  215.     return [concat {menu -m -n} [list $name] $pproc [list $menu]]
  216. }
  217.  
  218. #############################################################################
  219. #  Build a submenu of "preattached" Perl filters using the names of the 
  220. #  scripts in the Text Filters directory
  221. #
  222. proc perlFilterMenu {} {
  223.     global perlFilterPath
  224.     set scriptDir [scriptFolder]
  225.     if {![file exists $scriptDir]} {
  226.        cd [macperlFolder]
  227.        mkdir {Text Filters}
  228.        alertnote "Creating new \"Text Filters\" folder in MacPerl folder" 
  229.        cd
  230.     }
  231.     return [buildSubMenu $scriptDir TextFilters textFiltersProc perlFilterPath]
  232. }
  233.  
  234. #############################################################################
  235. #  Build the perl menu
  236. #
  237. proc rebuildPerlMenu {} {
  238.     global perlMenu perlOverwrite perlUsebuffer perlGetOutput perlAutoSwitch
  239.     global perlPrevScript perlPromptArgs
  240.             
  241.     set perlMenu "•132"
  242.     menu -n $perlMenu [ concat {
  243.         "macperl"
  244.         {menu -m -n "tellMacperl..." -p perlTellProc {
  245.            "Open This File"
  246.            "Get Output Window"
  247.            "Quit"
  248.            }
  249.         } 
  250.         "(-"
  251.         "runTheSelection"
  252.         "runTheBuffer"
  253.         "runAFile"
  254.         "(-"
  255.         } [list [perlFilterMenu]] {
  256.         {menu -n OtherTextFilters {
  257.            "selectABuffer"
  258.            "selectAFile"
  259.            }
  260.         } 
  261.         "repeatLastFilter"
  262.         {menu -m -n openSpecial -p perlOpenFile {
  263.            "STDIN"
  264.            "STDOUT"
  265.            "SCRIPT"
  266.            }
  267.         } 
  268.         "(-"
  269.         "retrieveOutput"
  270.         "autoSwitch"
  271.         "promptForArgs"
  272.         "applyToBuffer"
  273.         "overwriteSelection"
  274.         "(-"
  275.         "rebuildPerlMenu"
  276.         } ]
  277.  
  278.     markMenuItem $perlMenu retrieveOutput $perlGetOutput
  279.     markMenuItem $perlMenu autoSwitch $perlAutoSwitch
  280.     markMenuItem $perlMenu overwriteSelection $perlOverwrite
  281.     markMenuItem $perlMenu applyToBuffer $perlUsebuffer
  282.     markMenuItem $perlMenu promptForArgs $perlPromptArgs
  283.     if {$perlPrevScript == {} || $perlPrevScript == {*startup*}} {
  284.         enableMenuItem $perlMenu repeatLastFilter 0
  285.     }
  286. }
  287.  
  288. if ([info exists macperlPath]) {
  289.     rebuildPerlMenu
  290. }
  291.  
  292. # Keep global vars and modeVars consistent.
  293. #
  294. trace variable PerlmodeVars(perlOverwrite) w shadowPerl
  295. trace variable PerlmodeVars(perlUsebuffer) w shadowPerl
  296. trace variable PerlmodeVars(perlGetOutput) w shadowPerl
  297. trace variable PerlmodeVars(perlAutoSwitch) w shadowPerl
  298. trace variable PerlmodeVars(perlPromptArgs) w shadowPerl
  299. trace variable PerlmodeVars(perlLastFilter) w shadowPerl
  300. trace variable PerlmodeVars(perlCmdlineArgs) w shadowPerl
  301.  
  302. # ShadowPerl sets the global vars when the mode vars are modified and
  303. # keeps the menu checkmarked correctly.
  304. #
  305. proc shadowPerl {name1 name2 op} {
  306.     global perlMenu perlOverwrite perlUsebuffer perlGetOutput perlAutoSwitch
  307.     global perlPromptArgs perlPrevScript perlCmdlineArgs 
  308.     global PerlmodeVars
  309.     if {$name1 == "PerlmodeVars" && $op == "w"} {
  310.         switch $name2 {
  311.             "perlOverwrite"    {
  312.                 set perlOverwrite $PerlmodeVars(perlOverwrite)
  313.                 markMenuItem $perlMenu overwriteSelection $perlOverwrite
  314.              }
  315.             "perlUsebuffer"    {
  316.                 set perlUsebuffer $PerlmodeVars(perlUsebuffer)
  317.                 markMenuItem $perlMenu applyToBuffer $perlUsebuffer
  318.              }
  319.             "perlGetOutput"    {
  320.                 set perlGetOutput $PerlmodeVars(perlGetOutput)
  321.                 markMenuItem $perlMenu retrieveOutput $perlGetOutput 
  322.             }
  323.             "perlAutoSwitch" {    
  324.                 set perlAutoSwitch $PerlmodeVars(perlAutoSwitch)
  325.                 markMenuItem $perlMenu autoSwitch $perlAutoSwitch 
  326.             }
  327.             "perlPromptArgs" {    
  328.                 set perlPromptArgs $PerlmodeVars(perlPromptArgs)
  329.                 markMenuItem $perlMenu promptForArgs $perlPromptArgs 
  330.             }
  331.             "perlCmdlineArgs" {    
  332.                 set perlCmdlineArgs $PerlmodeVars(perlCmdlineArgs)
  333.             }
  334.             "perlLastFilter" {    
  335.                 # Don't allow perlPrevScript to be changed from the flags menu
  336.                 if {$perlPrevScript == "*startup*"} {
  337.                     set perlPrevScript $PerlmodeVars(perlLastFilter)
  338.                     enableMenuItem $perlMenu repeatLastFilter 1
  339.                 } else {
  340.                     set PerlmodeVars(perlLastFilter) $perlPrevScript 
  341.                 }
  342.             }
  343.             default {
  344.                 return
  345.             }
  346.         }
  347.     }
  348. }
  349.  
  350. #############################################################################
  351. # Menu commands
  352. #############################################################################
  353.  
  354. ############################################################################
  355. # Toggle the perl menu flags
  356. #
  357. proc retrieveOutput {} {
  358.     global perlMenu PerlmodeVars perlGetOutput modifiedModeVars
  359.     lappend modifiedModeVars perlGetOutput
  360.     if {$perlGetOutput} then {
  361.         set PerlmodeVars(perlGetOutput) 0
  362.     } else {
  363.         set PerlmodeVars(perlGetOutput) 1
  364.     }
  365. }
  366.  
  367. proc autoSwitch {} {
  368.     global perlMenu PerlmodeVars perlAutoSwitch modifiedModeVars
  369.     lappend modifiedModeVars perlAutoSwitch
  370.     if {$perlAutoSwitch} then {
  371.         set PerlmodeVars(perlAutoSwitch) 0
  372.     } else {
  373.         set PerlmodeVars(perlAutoSwitch) 1
  374.     }
  375. }
  376.  
  377. proc overwriteSelection {} {
  378.     global perlMenu perlOverwrite PerlmodeVars modifiedModeVars
  379.     lappend modifiedModeVars perlOverwrite
  380.     if {$perlOverwrite} then {
  381.         set PerlmodeVars(perlOverwrite) 0
  382.     } else {
  383.         set PerlmodeVars(perlOverwrite) 1
  384.     }
  385. }
  386.  
  387. proc applyToBuffer {} {
  388.     global perlMenu perlUsebuffer PerlmodeVars modifiedModeVars
  389.     lappend modifiedModeVars perlUsebuffer
  390.     if {$perlUsebuffer} then {
  391.            set PerlmodeVars(perlUsebuffer) 0
  392.     } else {
  393.            set PerlmodeVars(perlUsebuffer) 1
  394.     }
  395. }
  396.  
  397. proc promptForArgs {} {
  398.     global perlMenu perlPromptArgs PerlmodeVars modifiedModeVars
  399.     lappend modifiedModeVars perlPromptArgs
  400.     if {$perlPromptArgs} then {
  401.            set PerlmodeVars(perlPromptArgs) 0
  402.     } else {
  403.            set PerlmodeVars(perlPromptArgs) 1
  404.     }
  405. }
  406.  
  407. #############################################################################
  408. # Switch to MacPerl:
  409. # 
  410. proc macperl {} {
  411.     global macperlPath
  412.     set name [checkRunning MacPerl McPL macperlPath]
  413.     if {[string length $name]} {
  414.         switchTo "MacPerl"
  415.     } else {
  416.         alertnote "Couldn't run MacPerl"
  417.     }
  418. }
  419.  
  420. #############################################################################
  421. # Interact with MacPerl in some other way besides executing a script
  422. #
  423. proc perlTellProc {menu name} {
  424.     if {$name == "Open This File"} {
  425.         openInMacperl
  426.     } elseif {$name == "Get Output Window"} {
  427.         openPerlOutput
  428.     } elseif {$name == "Quit"} {
  429.         quitMacperl
  430.     }
  431. }
  432.  
  433. #############################################################################
  434. # Open the current file under MacPerl.  This is useful if you want to save it 
  435. # as a droplet or runtime script.
  436. #
  437. proc openInMacperl {} {
  438.     global macperlPath
  439.     set name [checkRunning MacPerl McPL macperlPath]
  440.     if {![string length $name]} {
  441.         alertnote "Couldn't run MacPerl"
  442.     }
  443.  
  444.     if {[winInfo dirty]} {
  445.         case [askyesno -c "Save '[lindex [winNames] 0]'?"] in {
  446.             "yes" {save}
  447.             "no" {}
  448.             "cancel" {return}
  449.         }
  450.     }
  451.     switchTo $name
  452.     sendOpenEvent -n $name [lindex [winNames -f] 0]
  453. }
  454.  
  455. #############################################################################
  456. # Quit a running MacPerl app:
  457. # 
  458. proc quitMacperl {} {
  459.     foreach proc [processes] {
  460.         set sig [lindex $proc 1]
  461.         if {$sig == "McPL"} {
  462.             sendQuitEvent [lindex $proc 0]
  463.             # switchTo is necessary to keep MacPerl from blinking
  464.             switchTo [lindex $proc 0]    
  465.         }
  466.     }
  467. }
  468.  
  469. #############################################################################
  470. # Run the selection as a MacPerl script:
  471. # (No special arrangements are made to provide input or capture the output)
  472. # 
  473. proc runTheSelection {} {
  474.     global scriptFile scriptStart
  475.     set scriptFile [lindex [winNames -f] 0]
  476.     set scriptStart [lindex [posToRowCol [getPos]] 0]
  477.     perlExecuteScript [getSelect]
  478. }
  479.  
  480. proc runTheBuffer {} {
  481.     global scriptFile scriptStart
  482.     set scriptFile [lindex [winNames -f] 0]
  483.     set scriptStart 1
  484.     perlExecuteScript [getText 0 [maxPos]]
  485. }
  486.  
  487. proc runAFile {} {
  488.     global scriptFile scriptStart
  489.     if {! [catch {getfile "Select a Perl script"} path]} {
  490.         set scriptFile $path
  491.         set scriptStart 1
  492.         perlExecuteFile $path
  493.     }
  494. }
  495.  
  496. #############################################################################
  497. # Run a preattached Perl text-filter script selected from the menu:
  498. #
  499. proc textFiltersProc {menu name} {
  500.     global perlFilterPath scriptFile scriptStart
  501.     
  502.     perlFileAsFilter $perlFilterPath($menu:$name)
  503. }
  504.  
  505. #############################################################################
  506. # Reuse the previous (buffer or file) filter:
  507. #
  508. proc repeatLastFilter {} {
  509.     global scriptFile scriptStart perlPrevScript perlMenu PerlmodeVars
  510.     if {$perlPrevScript != {}} {
  511.         set stype [lindex $perlPrevScript 0]
  512.         set name [lindex $perlPrevScript 1]
  513.         if {$stype == "file"} {
  514.             perlFileAsFilter $name
  515.         } elseif {$stype == "buffer"} {
  516.             perlBufferAsFilter $name
  517.         } else {
  518.             message "Bogus filter name : \"$perlPrevScript\""
  519.             set perlPrevScript {}
  520.             set PerlmodeVars(perlLastFilter) $perlPrevScript 
  521.             enableMenuItem $perlMenu repeatLastFilter 0
  522.         }
  523.     }
  524. }
  525.  
  526. #############################################################################
  527. # Ask for a file containing a Perl script to use as a filter:
  528. #
  529. proc selectAFile {} {
  530.     global scriptFile scriptStart perlPrevScript
  531.     if {! [catch {getfile "Select a MacPerl script"} path]} {
  532.         perlFileAsFilter $path
  533.     }
  534. }
  535.  
  536. #############################################################################
  537. # Ask for an Alpha buffer containing a Perl script to use as a filter:
  538. #
  539. proc selectABuffer {} {
  540.     global scriptFile scriptStart perlPrevScript
  541.     
  542.     set windows [winNames]
  543.     set current [lindex $windows 0]
  544.     if {[llength $windows] > 1} {
  545.         set name [listpick [lsort $windows]]
  546.         if {[string length $name]} {
  547.             # get the full name of the chosen window
  548.             set wname [lindex [winNames -f] [lsearch -exact $windows $name]]
  549.             perlBufferAsFilter $wname
  550.            }
  551.     }
  552. }
  553.  
  554. #############################################################################
  555. # Open a file from the MacPerl application folder - used by "Open Special"
  556. #
  557. proc perlOpenFile {menu name} {
  558.     set filename [macperlFolder]$name
  559.     if {[file exists $filename]} {
  560.         edit $filename
  561.     } else {
  562.         alertnote "That file doesn't exist yet"
  563.     }
  564. }
  565.  
  566. #############################################################################
  567. # Support procs
  568. #############################################################################
  569.  
  570. #############################################################################
  571. # Prompt the user to enter a string containing command-line args.
  572. #
  573. proc getCmdlineArgs {} {
  574.     global PerlmodeVars
  575.     set oldargs $PerlmodeVars(perlCmdlineArgs)
  576.     if {![catch {prompt "Command-line arguments (if any):" $oldargs} args]} {
  577.         set PerlmodeVars(perlCmdlineArgs) $args
  578.     } else {
  579.         error "getCmdlineArgs: User cancelled"
  580.     }
  581.     return $args
  582. }
  583.  
  584. #############################################################################
  585. # Tell MacPerl to run a script file:
  586. #
  587. proc perlExecuteFile {path {args ""}} {
  588.     global ALPHA macperlPath
  589.     global perlGetOutput perlAutoSwitch perlPromptArgs
  590.     global scriptFile scriptStart
  591.     
  592.     if {[string length $path]} {
  593.         set name [checkRunning MacPerl McPL macperlPath]
  594.         if {[string length $name]} {
  595.         
  596.             set scriptFile $path
  597.             set scriptStart 1            
  598.             
  599. #            set args [readFileForArgs $path]
  600. #            set args ""
  601.             if {$perlPromptArgs} { 
  602.                 append args " [getCmdlineArgs]"
  603.             }
  604.             
  605.             sendCloseWinName MacPerl MacPerl
  606.             if {$perlAutoSwitch} then {switchTo $name} else {watchCursor}
  607.             if {[llength $args]} {
  608.                 perlDoScript2 "MacPerl" $path $args
  609.             } else {
  610.                 dosc -c 'McPL' -t 0 -f $path
  611.             }
  612. # (not sure which choice is better...)
  613. #            if {!$perlAutoSwitch} then {switchTo $ALPHA}
  614.             switchTo $ALPHA
  615. #
  616.             if {![getMacPerlError $scriptFile $scriptStart 0]} {
  617.                 if {$perlGetOutput} then {openPerlOutput}
  618.             }
  619.         } else {
  620.             alertnote "Couldn't run MacPerl"
  621.         }
  622.     } else {
  623.         alertnote "No file specified to execute"
  624.     }
  625. }
  626.  
  627. #############################################################################
  628. # Run a MacPerl script, passed explicitly as a string:
  629. #
  630. # If no "#!/bin/perl" line already exists, one is preprended to the script
  631. # by wrapSelectScript, which also sets $filterHeadLen for use by 
  632. # getMacPerlError.
  633. # 
  634. proc perlExecuteScript {script {args ""}} {
  635.     global macperlPath perlGetOutput perlAutoSwitch perlPromptArgs
  636.     global scriptFile scriptStart filterHeadLen ALPHA
  637.     if {$script != ""} {
  638.         set script [wrapSelectScript $script]
  639.         writeScript $script
  640.         set name [checkRunning MacPerl McPL macperlPath]
  641.         if {[string length $name]} {
  642. #            set args [getScriptArgs $script]
  643. #            set args ""
  644.             if {$perlPromptArgs} { 
  645.                 append args " [getCmdlineArgs]"
  646.             }
  647.             sendCloseWinName MacPerl MacPerl
  648.             if {$perlAutoSwitch} then {switchTo $name} else {watchCursor}
  649.             if {[llength $args]} {
  650.                 perlDoScript2 "MacPerl" [scriptPath] $args
  651.             } else {
  652.                 dosc -c 'McPL' -t 0 -f [scriptPath]    
  653.             }
  654. # (not sure which choice is better...)
  655. #            if {!$perlAutoSwitch} then {switchTo $ALPHA}
  656.             switchTo $ALPHA
  657. #
  658.             if {![getMacPerlError $scriptFile $scriptStart $filterHeadLen]} {
  659.                 if {$perlGetOutput} then {openPerlOutput}
  660.             }
  661.         } else {
  662.             alertnote "Couldn't run MacPerl"
  663.         }
  664.     } else {
  665.             alertnote "No file specified to execute"
  666.     }
  667. }
  668.  
  669. #############################################################################
  670. # Prepare the contents of a disk file for use as a text-filter script. 
  671. # (calls perlTextFilter to actually run the script)
  672. # 
  673. proc perlFileAsFilter {path} {
  674.     global scriptFile scriptStart perlPrevScript perlMenu PerlmodeVars
  675.     
  676.     regexp {(.*):([^:]*)} $path pathname dirname name
  677.     
  678.     set coreScript [readFile $path]
  679.     if {$coreScript != -1} {
  680.         set script [wrapFilterScript $coreScript]
  681.         set scriptFile $path
  682.         set scriptStart 1
  683.         set perlPrevScript [list "file" $path]
  684.         set PerlmodeVars(perlLastFilter) $perlPrevScript 
  685.         enableMenuItem $perlMenu repeatLastFilter 1
  686.         message "Running file \"$name\" as text filter ..."
  687.             
  688.         perlTextFilter $script
  689.     } else {
  690.         set perlPrevScript {}
  691.         set PerlmodeVars(perlLastFilter) $perlPrevScript 
  692.         enableMenuItem $perlMenu repeatLastFilter 0
  693.         
  694.         alertnote "Couldn't read the script file : $path"
  695.         return
  696.     }
  697. }
  698.  
  699. #############################################################################
  700. # Prepare the contents of a text window for use as a text-filter script. 
  701. # (calls perlTextFilter to actually run the script)
  702. # 
  703. proc perlBufferAsFilter {wname} {
  704.     global scriptFile scriptStart perlPrevScript perlMenu PerlmodeVars
  705.  
  706.     regexp {(.*):([^:]*)} $wname pathname dirname name
  707.     
  708.     if {[lsearch [winNames -f] $wname] >= 0} {
  709.         set coreScript [getText -w $wname 0 [maxPos -w $wname]]
  710.         
  711.         # Does it have any text in it?
  712.         if {[string length $coreScript]} {
  713.             set scriptFile $wname
  714.             set scriptStart 1
  715.             set script [wrapFilterScript $coreScript]
  716.             set perlPrevScript [list "buffer" $wname]
  717.             set PerlmodeVars(perlLastFilter) $perlPrevScript 
  718.             enableMenuItem $perlMenu repeatLastFilter 1
  719.             message "Running buffer \"$name\" as text filter ..."
  720.             
  721.             perlTextFilter $script
  722.         }
  723.     } else {
  724.         set perlPrevScript {}
  725.         set PerlmodeVars(perlLastFilter) $perlPrevScript 
  726.         enableMenuItem $perlMenu repeatLastFilter 0
  727.  
  728.         alertnote "Couldn't find buffer : $name"
  729.     }
  730. }
  731.  
  732. #############################################################################
  733. # Run a Perl script as a command-line text filter, arranging for a text
  734. # buffer to be attached as standard input.  The calling routine should already
  735. # have processed the script with wrapFilterScript.  This routine actually
  736. # send the script and takes care of writing the input and reading the output 
  737. # files.
  738. # 
  739. proc perlTextFilter {script {args ""}} {
  740.     global macperlPath perlOverwrite perlUsebuffer perlPromptArgs
  741.     global filterHeadLen scriptFile scriptStart ALPHA
  742.  
  743.     set name [checkRunning MacPerl McPL macperlPath]
  744.     if {![string length $name]} {
  745.         alertnote "Couldn't run MacPerl"
  746.         error "Couldn't run MacPerl"
  747.     }
  748.     writeStdin
  749. #    no longer useful, since errors are (hopefully) trapped now.
  750. #    writeStdout
  751.  
  752.     if {$perlPromptArgs} { 
  753.         append args " [getCmdlineArgs]"
  754.     }
  755.     
  756.     sendCloseWinName MacPerl MacPerl
  757.     watchCursor
  758.     perlDoScript2 "MacPerl" [scriptPath] $args [stdinPath]
  759.     switchTo $ALPHA
  760.     if {![getMacPerlError $scriptFile $scriptStart $filterHeadLen]} {
  761.         if {!$perlOverwrite} {new -n {* Perl Output *}}
  762.         if {$perlUsebuffer} {
  763.             pasteStdout 0 [maxPos]
  764.         } else {
  765.             pasteStdout [getPos] [selEnd]
  766.         }
  767.         if {!$perlOverwrite || $perlUseBuffer} {
  768.             catch shrinkWindow
  769.             goto 0
  770.         }
  771.     }
  772. }
  773.  
  774. #############################################################################
  775. # Check the MacPerl output window for error messages.
  776. #
  777. proc getMacPerlError {scriptFile scriptStart offset} {
  778. #    global winModes
  779.     set pat0 {^[ \t]*$}
  780.     set pat1 {^#(.*)$}
  781.     set pat2 {File '[^']+'; Line ([0-9]+)}
  782.     
  783.     # first see if there's any output at all
  784.     set nlines [sendCountLines MacPerl MacPerl]
  785.     if {$nlines == 0} {
  786.         return 0
  787.     }
  788.     set errFound 0
  789.     set errMessage {}
  790.     set lines {}
  791.     
  792. #     # read output window one line at a time
  793. #    set nread 0
  794. #     while {$nread < $nlines} {
  795. #         incr nread
  796. #         set line [sendGetText MacPerl MacPerl $nread]
  797. #[...]
  798. #     }
  799.  
  800.     # read a window-full of MacPerl output (faster, but assumes 
  801.     # error message won't appear at the end of a lot of output).
  802.     set maxLines [expr ($nlines > 40)?40:$nlines]
  803.     set output [sendGetText MacPerl MacPerl 1 $maxLines]
  804.     foreach line [split $output "\r"] {
  805.         if {[regexp $pat2 $line mtch num]} {
  806.             set errFound 1
  807.         } elseif {[regexp $pat1 $line mtch err]} {
  808.             if {$errFound == 0} {
  809.                 set errMessage $err
  810.             }
  811.         } elseif {[regexp $pat0 $line mtch]} {
  812.             break
  813.         }
  814.         append lines "$line\n"
  815.     }
  816.  
  817.     if {$errFound} {
  818.         new -n {* Perl Error Messages *} 
  819.          insertText $lines
  820.         goto 0
  821.         catch {shrinkWindow 1}
  822.         setWinInfo dirty 0
  823.         setWinInfo read-only 1
  824.         
  825.         # Now get the line number associated with the first error
  826.         regexp $pat2 $lines mtch num
  827.         # Convert it to the line number in the original file
  828.         set lineNum [expr $num + $scriptStart - $offset - 1]
  829.         # Bring up the script file and highlight the flagged line
  830.         catch {gotoFileLine $scriptFile $lineNum} fname    
  831.         # ... and leave an informative error message
  832.         if {$errMessage != {}} {
  833.             message "$errMessage at Line $lineNum"            
  834.         } else {
  835.             message "MacPerl flagged an error at Line $lineNum"    
  836.         }
  837.         return 1
  838.         
  839.     } else {
  840.         return 0
  841.     }
  842. }
  843.  
  844. #############################################################################
  845. #  Highlight (select) a particular line in the designated file, opening the
  846. #  file if necessary.  Returns the full name of the buffer containing the
  847. #  opened file.
  848. #
  849. proc gotoFileLine {fname line} {
  850.     if {[expr {[lsearch [winNames -f] "*$fname"] >= 0}]} {
  851.         bringToFront $fname
  852.     } elseif {[expr {[lsearch [winNames] "*$fname"] >= 0}]} {
  853.         bringToFront $fname
  854.     } elseif {[file exists $fname]} {
  855.         edit $fname
  856.     } else {
  857.         alertnote "File \" $fname \" not found." ; return
  858.     }
  859.     set pos [rowColToPos $line 0]
  860.     select [lineStart $pos] [nextLineStart $pos]
  861.     return [lindex [winNames -f] 0]
  862. }
  863.  
  864. #############################################################################
  865. #  Take a Perl script and add commands to take the file STDIN as standard
  866. #  input and STDOUT as standard output.  This allows scripts written as
  867. #  Unix command-line filters to be used in the (non-MPW) Mac environment as
  868. #  text filters.
  869. #
  870. #  If there's already a #! line in the script, then the new commands
  871. #  are added after that line.  If there was no #! line in the first place,
  872. #  one is added, in case MacPerl is set up to require it (can't hurt...) 
  873. #
  874. #  $filterHeadLen counts the number of lines we add to the top of the
  875. #  original script, so that we can allow for it in interpreting error
  876. #  messages issued by MacPerl.
  877. #
  878. proc wrapFilterScript {coreScript} {
  879.     global filterHeadLen
  880.  
  881.     if {[regexp -indices {(#![     !-~]*)} $coreScript allofit cmdln]} {
  882.         set endPos [lindex $cmdln 1]
  883.         set filterHead [string range $coreScript 0 [expr $endPos+1]]
  884.         set coreScript [string range $coreScript [expr $endPos+2] end]
  885.         set filterHeadLen 0
  886.     } else {
  887.         set filterHead "#!/bin/perl\n"
  888.         set filterHeadLen 1
  889.     }
  890.     append filterHead "\$macperlDir = \"[macperlFolder]\" ;\n"
  891. # Pass the input file as a command-line file arg, instead.
  892. #    append filterHead "open(STDIN, \"<[stdinPath]\" ) ;\n"
  893.     append filterHead "open(STDOUT, \">[stdoutPath]\" ) ;\n"
  894.     append filterHead "select(STDOUT) ;\n\n"
  895.     incr filterHeadLen 6
  896.     
  897.     set filterTail "\nclose STDIN ;\nclose STDOUT ;\n"
  898.         
  899.     set script $filterHead
  900.     append script $coreScript
  901.     append script $filterTail
  902.     
  903.     writeScript $script
  904.     return $script
  905. }        
  906.  
  907. #############################################################################
  908. #  Add a #!/bin/perl line to the script if it doesn't contain one already.
  909. #  (MacPerl puts up dialog if this line is missing when it expects it,
  910. #  hanging the DoScript and leaving us stuck.)
  911. #
  912. proc wrapSelectScript {coreScript} {
  913.     global filterHeadLen
  914.  
  915.     if {![regexp -indices {(#![     !-~]*)} $coreScript allofit cmdln]} {
  916.         set script "#!/bin/perl\n"
  917.         append script $coreScript
  918.         set filterHeadLen 1
  919.     } else {
  920.         set script $coreScript
  921.         set filterHeadLen 0
  922.     }
  923.     
  924.     writeScript $script
  925.     return $script
  926. }        
  927.  
  928. #############################################################################
  929. #  Paste the text of the file STDOUT in place of the current selection.
  930. #
  931. proc pasteStdout {from to} {
  932.     set result [readFile [stdoutPath]]
  933.     if {$result != -1} {
  934.         deleteText $from $to
  935.         insertText $result
  936.         catch shrinkWindow
  937.         goto 0
  938.     } else {
  939.         alertnote "Couldn't find the output file : STDOUT"
  940.     }
  941. }    
  942. #        replaceText [getPos] [selEnd] $result
  943.  
  944. #############################################################################
  945. #  Extend the current selection to encompass complete lines.  If the 
  946. #  'applyToBuffer' flag is checked, then the entire buffer is selected.
  947. #
  948. proc completeSelection {} {
  949.     global perlUsebuffer
  950.     if {$perlUsebuffer} {
  951.         set start 0
  952.         set end [maxPos]
  953.     } else {
  954.         set start [lineStart [getPos]]
  955.         set end [nextLineStart [expr [selEnd]-1]]
  956.     }
  957.     if {$end == $start} {set end [nextLineStart [selEnd]]}
  958.     return [list $start $end]
  959. }
  960.  
  961. #############################################################################
  962. #  writeStdin: Extend the selection, as appropriate, and write it to the 
  963. #     STDIN file in the MacPerl directory.
  964. #  writeStdout: Write the extended selection to the STDOUT file.  This will
  965. #      then be the default output in case MacPerl hangs. 
  966. #  writeScript: Write the SCRIPT file in the MacPerl directory.  MacPerl will
  967. #     read the script from this file. 
  968. #
  969. proc writeStdin {} {
  970.     set res [completeSelection]
  971.     set tmpfid [open [stdinPath] "w+"]
  972.     puts $tmpfid [eval getText $res]
  973.     close $tmpfid
  974. }
  975.  
  976. # This should be unnecessary now that we're watching for MacPerl errors...
  977. proc writeStdout {} {
  978.     set res [completeSelection]
  979.     set tmpfid [open [stdoutPath] "w+"]
  980.     puts $tmpfid [eval getText $res]
  981.     close $tmpfid
  982. }
  983.  
  984. # This will hopefully be unnecessary with the next release of MacPerl...
  985. proc writeScript {script} {
  986.     set tmpfid [open [scriptPath] "w+"]
  987.     puts $tmpfid $script 
  988.     close $tmpfid
  989. }
  990.  
  991. #############################################################################
  992. #  Read and return the complete contents of the specified file.
  993. #
  994. proc readFile {fileName} {
  995.     if {[file exists $fileName] && [file readable $fileName]} {
  996.        set fileid [open $fileName "r"]
  997.        set contents ""
  998.        while {[gets $fileid nextLine] != -1} {
  999.           append contents $nextLine "\n"
  1000.        }
  1001.        close $fileid
  1002.        return $contents
  1003.     } else {
  1004.        return -1
  1005.     }
  1006. }
  1007.  
  1008. #############################################################################
  1009. #  Scan a file for a command line, and return the arguments found.
  1010. #
  1011. proc readFileForArgs {fileName} {
  1012.     if {[file exists $fileName] && [file readable $fileName]} {
  1013.         set fileid [open $fileName "r"]
  1014.         set contents ""
  1015.         while {[gets $fileid nextLine] != -1} {
  1016.             if {[regexp {^[ \t]*#![^ \t]+(.*)$} $nextLine mtch args]} {
  1017.                 close $fileid
  1018.                 set args [string trim $args]
  1019.                 return $args
  1020.             }
  1021.         }
  1022.         close $fileid
  1023.         return ""
  1024.     } else {
  1025.         return -1
  1026.     }
  1027. }
  1028.  
  1029. #############################################################################
  1030. #  Scan a script for a command line, and return the arguments found.
  1031. #
  1032. proc getScriptArgs {script} {
  1033.     set lines [split $script "\r"]
  1034.     foreach line $lines {
  1035.         if {[regexp {^[ \t]*#![^ \t]+(.*)$} $line mtch args]} {
  1036.             set args [string trim $args]
  1037.             return $args
  1038.         }
  1039.     }
  1040.     return ""
  1041. }
  1042.  
  1043. #############################################################################
  1044. # Read the MacPerl output window and load the contents, if any, into
  1045. # a new Alpha window. 
  1046. #
  1047. proc openPerlOutput {} {
  1048.     set output [sendGetText MacPerl MacPerl]
  1049.     if {[string length $output]} {
  1050.         new -n {* MacPerl Output *}
  1051.         insertText $output
  1052.         catch {shrinkWindow 1}
  1053.         goto 0
  1054.     }
  1055. }
  1056.  
  1057. #############################################################################
  1058. # General Apple Event routines
  1059. # (These should work with any application that supports the appropriate events)
  1060. #
  1061.  
  1062. # Get the name that Alpha is running under, so we can switch back here 
  1063. # explicitly when needed.
  1064. foreach p [processes] {
  1065.     if {[lindex $p 1] == "ALFA"} {
  1066.         set ALPHA [lindex $p 0]
  1067.         break
  1068.     }
  1069. }
  1070.  
  1071. # AEBuild utility functions
  1072. proc curlyq {str} {
  1073.     return "\“$str\”"
  1074. }
  1075. proc AEAbsPos {posName} {
  1076. # (would like to be able to use 'first' and 'last' as well, but haven't yet
  1077. # figured out the correct AEBuild syntax.  "seld:abso('firs')" doesn't work.)
  1078.     if {$posName > 0} {
  1079.         return "form:indx, seld:long($posName)"
  1080.     } else {
  1081.         error "AEAbsPos: bad argument"
  1082.     }
  1083. }
  1084. proc AEName {name} {
  1085.     return "form:'name', seld:[curlyq $name]"
  1086. }
  1087. proc AEWinByName {name} {
  1088.     return "obj{want:type('cwin'), from:'null'(), [AEName $name] } "
  1089. }
  1090. proc AEWinByPos {absPos} {
  1091.     return "obj{want:type('cwin'), from:'null'(), [AEAbsPos $absPos] } "
  1092. }
  1093. proc AELineRange {absPos1 absPos2} {
  1094.     set lineObj1 "obj{ want:type('clin'), from:'ccnt'(), [AEAbsPos $absPos1] }"
  1095.     set lineObj2 "obj{ want:type('clin'), from:'ccnt'(), [AEAbsPos $absPos2] }"
  1096.     return "form:'rang', seld:rang{star:$lineObj1, stop:$lineObj2 } "
  1097. }
  1098.  
  1099. # Quit an application.
  1100. proc sendQuitEvent {appname} {
  1101.     AEBuild $appname "aevt" "quit" 
  1102. }
  1103.  
  1104. # Close one of an application's windows, designated by number.
  1105. proc sendCloseWinNum {appname num} {
  1106.     AEBuild $appname "core" "clos" "----" [AEWinByPos $num]
  1107. }
  1108.  
  1109. # Close one of an application's windows, designated by name.
  1110. proc sendCloseWinName {appname name} {
  1111.     AEBuild $appname "core" "clos" "----" [AEWinByName $name]
  1112. }
  1113.  
  1114. # Obtain the number of lines in one of an application's
  1115. # windows, designated by name.
  1116. proc sendCountLines {appname name} {
  1117.     set winObj [AEWinByName $name]
  1118.     set res [AEBuild -r $appname "core" "cnte" "----" $winObj kocl type('clin')]    
  1119.     if {[regexp {:(.*)\}} $res allofit nlines]} {
  1120.         return $nlines
  1121.     } else {
  1122.         return 0
  1123.     }
  1124. }
  1125.  
  1126. # Get a selected range of lines from one of an application's
  1127. # windows, designated by name.  If $last is missing, then a single
  1128. # line is returned; if both $first and $last are missing, then
  1129. # the complete window contents are returned.
  1130. proc sendGetText {appname name {first {missing}} {last {missing}}} {
  1131.     global ALPHA
  1132.     set winObj [AEWinByName $name]
  1133.     if {$first != "missing"} {
  1134.         if {$last != "missing"} {
  1135.             set rangDesc [AELineRange $first $last]
  1136.         } else {
  1137.             set rangDesc [AEAbsPos $first]
  1138.         }
  1139.         set objDesc "obj{want:type('clin'), from:$winObj, $rangDesc }"
  1140.     } else {
  1141.         set objDesc "obj{want:type('ctxt'), from:$winObj, form:'indx', seld:abso('all') }"
  1142.     }
  1143.     set res [AEBuild -r $appname "core" "getd" "----" $objDesc]    
  1144.     if {![regexp {“.*”} $res text]} { set text {} }
  1145.     return [string trim $text {“”}]
  1146. }
  1147.  
  1148. # Send a DoScript event, optionally including the special flags recognized
  1149. # by MacPerl.  (debugged, but not currently used)
  1150. proc perlDoScript {appname script {flags {}}} {
  1151.     if {$script != ""} {
  1152.         append descriptor " ---- {[curlyq $script]}"
  1153.     } else {
  1154.         error "perlDoScript: missing script argument"
  1155.     }        
  1156.     set usrf {}
  1157.     if {[lsearch -exact $flags "extract"] >= 0} {
  1158.         append usrf { "EXTR" 'true'}
  1159.     } elseif {[lsearch -exact $flags "noextract"] >= 0} {
  1160.         append usrf { "EXTR" 'fals'}
  1161.     }        
  1162.     if {[lsearch -exact $flags "debug"] >= 0} {
  1163.         append usrf { "DEBG" 'true'}
  1164.     } elseif {[lsearch -exact $flags "nodebug"] >= 0} {
  1165.         append usrf { "DEBG" 'fals'}
  1166.     }        
  1167.     if {[lsearch -exact $flags "preprocess"] >= 0} {
  1168.         append usrf { "PREP" 'true'}
  1169.     } elseif {[lsearch -exact $flags "nopreprocess"] >= 0} {
  1170.         append usrf { "PREP" 'fals'}
  1171.     }        
  1172.     eval "AEBuild -r \"$appname\" misc dosc $descriptor $usrf"
  1173. }
  1174.  
  1175. proc perlDoScript2 {appname fname {args {}} {fileArg {}}} {
  1176.     set nargs 0
  1177.     if {$fname != ""} {
  1178.         set argv "\[[curlyq $fname]"
  1179.          foreach item [split [join $args " "] " "] {
  1180.             set item [string trim $item]
  1181.             if {[string length $item]} {
  1182.                 append argv ", [curlyq $item]"
  1183.                 incr nargs
  1184.             }
  1185.         }
  1186.         if {[string length $fileArg]} {
  1187. #             if {$nargs} {
  1188. #                 append argv ", [curlyq --]"
  1189. #             }
  1190.             append argv ", [curlyq $fileArg]"
  1191.         }
  1192.         append argv "]"
  1193.     set reply [eval "AEBuild -r \"$appname\" misc dosc \"----\" [list $argv]"]
  1194. #    alertnote $reply
  1195.     }
  1196. }
  1197.  
  1198. ##############################################################################
  1199. # Automatic subroutine marking for Perl mode in Alpha 5.85
  1200. #
  1201. # (code stolen shamelessly from 'tclMarkFile' in 'tcl.tcl')
  1202. #
  1203. proc PerlMarkFile {} {
  1204.     set end [maxPos]
  1205.     set pos 0
  1206.     set l {}
  1207.     while {![catch {search -f 1 -r 1 -m 0 -i 0 {^sub} $pos} res]} {
  1208.         set start [lindex $res 0]
  1209.         set end [nextLineStart $start]
  1210.         set text [lindex [getText $start $end] 1]
  1211.         set pos $end
  1212.         set inds($text) [lineStart [expr $start - 1]]
  1213.     }
  1214.  
  1215.     if {[info exists inds]} {
  1216.         foreach f [lsort [array names inds]] {
  1217.             set next [nextLineStart $inds($f)]
  1218.             setNamedMark $f $inds($f) $next $next
  1219.         }
  1220.     }
  1221. }
  1222.  
  1223. proc dummyPerl {} {
  1224. }
  1225.  
  1226. ##############################################################################
  1227. # Perl mode definitions  (for Alpha 5.90)
  1228. #
  1229. lappend modes Perl
  1230. set dummyProc(Perl)                dummyPerl
  1231. set modeMenus(Perl)                 { perlMenu }
  1232. lappend modeSuffixes            {*.pl} { set winMode Perl }
  1233. newModeVar Perl elecRBrace    {0} 1
  1234. newModeVar Perl elecLBrace    {1} 1
  1235. newModeVar Perl electricSemi    {0} 1
  1236. newModeVar Perl wordBreak        {(\$)?[a-zA-Z0-9_]+} 0
  1237. newModeVar Perl prefixString    {# } 0
  1238. newModeVar Perl wordWrap        {0} 1
  1239. newModeVar Perl funcExpr        {^sub *([+-a-zA-Z0-9]+)} 0
  1240. newModeVar Perl wordBreakPreface        {[^a-zA-Z0-9_\$]} 0
  1241. newModeVar Perl optionIsMeta    {1} 1
  1242.  
  1243. set perlKeywords {
  1244. accept alarm atan2 bind binmode caller chdir chmod chop chown chroot 
  1245. close closedir connect continue cos crypt dbmclose dbmopen defined 
  1246. delete die do dump each else elsif eof eval exec exit exp fcntl fileno 
  1247. flock for foreach fork getc getlogin getpeername getpgrp getppid 
  1248. getpriority getgrnam gethostbyname getnetbyname getprotobyname getpwuid 
  1249. getgrgid getservbyname gethostbyaddr getnetbyaddr getprotobynumber 
  1250. getservbyport getpwent getgrent gethostent getnetent getprotoent 
  1251. getservent setpwent setgrent sethostent setnetent setprotoent setservent 
  1252. endpwent endgrent endhostent endnetent endprotoent endservent 
  1253. getsockname getsockopt gmtime goto grep hex if index int ioctl join keys 
  1254. kill last length link listen local localtime log lstat lstat mkdir 
  1255. msgctl msgget msgsnd msgrcv next oct open opendir ord pack pipe pop 
  1256. print print printf printf push q qq qx rand read readdir readlink recv 
  1257. redo rename require reset return reverse rewinddir rindex rindex rmdir 
  1258. scalar seek seekdir select semctl semget semop send setpgrp setpriority 
  1259. setsockopt shift shmctl shmget shmread shmwrite shutdown sin sleep 
  1260. socket socketpair sort splice split sprintf sqrt srand stat study sub 
  1261. substr symlink syscall sysread system syswrite tell telldir time times 
  1262. tr truncate umask undef unless unlink unpack unshift until utime values 
  1263. vec wait waitpid wantarray warn while write eq ne cmp lt gt le ge @_ $_ $.  
  1264. $/ $, $" $\\ $\# $% $= $- $~ $^ $| $$ $? $& $` $' $+ $* $0 $1 $2 $3 $4 $5 
  1265. $6 $7 $8 $9 $[ $] $; $! $@ $< $> $( $) $: $^D $^F $^I $^P $^T $^W $^X 
  1266. $ARGV @ARGV @INC %INC $ENV $SIG
  1267. }
  1268. regModeKeywords -e {#} -c red -k blue Perl $perlKeywords
  1269. unset perlKeywords
  1270.                 
  1271. ##############################################################################
  1272. # Make sure Perl-mode is installed correctly if this file is loaded
  1273. # after the mode-variables menus have already been built.
  1274. #
  1275. set modes [lsort $modes]
  1276. buildFlagsVars
  1277.  
  1278. ##############################################################################
  1279.